Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Pascal/Libraries/MCC Utils/MCHandlesAndStrs.p

Text File | 1994-05-04 | 23.4 KB | 795 lines | [TEXT/PJMM]

{This document is formated in monaco 9 pt                                          }
{                                                                                  }
{LEGAL STUFF                                                                       }
{                                                                                  }
{Copyright © 1994 by University of Melbourne. All Rights Reserved. This work is    }
{provided "as is" and without any express or implied warranties, including,        }
{without limitation, the implied warranties of merchantability and fitness         }
{for a particular purpose.                                                         }
{                                                                                  }
{University of Melbourne is not responsible for the consequences of the use of this}
{work, regardless of the cause. You may use this work in a public domain,          }
{freeware, or shareware product with no restrictions, as long as you include       }
{the following notice in your product's about box or splash screen:                }
{  "Portions Copyright © 1994 by University of Melbourne".                         }
{If you use more than 50 lines of this work, please credit the author also:        }
{  "Portions by Michael Cutter"                                                    }
{Public domain is defined as something that you release to the public, without     }
{copyright and without restrictions on use. Freeware is a copyrighted work,        }
{for which you charge no money. Shareware is a copyrighted work for which you      }
{charge a fee if the user decides to keep it. If you intend to use this work       }
{in a commercial product, please contact us.                                       }
{                                                                                  }
{                                                                                  }
{OTHER STUFF                                                                       }
{                                                                                  }
{AUTHOR:                                                                           }
{ Michael Trevor Cutter                                                            }
{                                                                                  }
{CONTACT:                                                                          }
{  Internet:                                                                       }
{    [e-mail] (Preferred)                                          }
{  Snail Mail:                                                                     }
{    Dept of Architecture & Building                                               }
{    University of Melbourne                                                       }
{    Parkville VIC 3052                                                            }
{    AUSTRALIA                                                                     }
{                                                                                  }
{PERSONAL STUFF                                                                    }
{  I'd really appreciate it if you'd let me know what you're using my code         }
{  in, (send me email or a postcard). Please report any bugs or errors to me.      }
{                                                                                  }
{MODULE DESCRIPTION                                                                }
{This is a collection of functions which provide various                           }
{facilities for processing handles and pascal strings, and                         }
{converting between one form and another.                                          }
{Like all my code, it is probably not perfect, but any                             }
{bugs you find , please report them to me , so that I can                          }
{fix them!                                                                         }
{Note some of this stuff is ancient and highly embarrassing...                     }

unit MCHandlesAndStrs;

interface

{Sets the length of the string.}
    procedure MCSetStrLen (var str: Str255;
                                    len: longint);

{Returns the first 255 chars (or less) of the handle in the str}
    procedure MCHndlToStr (thehndl: Handle;
                                    var str: Str255);
{Counts the number of $0D delimited lines in a handle}
{NOTE: it provides the number of visible lines, NOT the number of returns in the handle}
{So if the first char is a return, it is ignored, and if the last char is not a return,}
{then it is also part of a line, etc.}
    function MCCountLinesInHndl (thehndl: Handle): longint;
{Returns line X from thehndl, and return it as a handle}
    function MCGetHndlLineXFromHndl (thehndl: handle;
                                    linex: longint): Handle;
{Returns the next line after offset from the handle as a handle}
    function MCGetNextHndlLineFromHndl (thehndl: handle;
                                    var offset: longint): Handle;
{Returns the next item after offset as delimited by delim as a handle}
    function MCGetNextHndlItemFromHndl (thehndl: handle;
                                    delim: char;
                                    var offset: longint): Handle;
{Returns line X from the handle as a string}
    function MCGetStrLineXFromHndl (thehndl: handle;
                                    linex: longint): str255;
{Returns the next line after offset from the handle as a string}
    function MCGetNextStrLineFromHndl (thehndl: handle;
                                    var offset: longint): Str255;
{Count the number of items in a string, as delimited by the char}
    function MCGetNumberOfItemsInStr (thestr: str255;
                                    delimiter: char): integer;
{Returns item X from the string as delimited by the char as a string}
    function MCGetStrItemXFromStr (thestr: Str255;
                                    itemx: integer;
                                    delimiter: char): str255;
{Returns item X from the handle as delimited by the char as a string}
    function MCGetStrItemXFromHndl (thehndl: Handle;
                                    itemx: longint;
                                    delimiter: char): str255;
{Returns the everything between offset and the next delimiter as a string}
    function MCGetStrItemOffsetFromHndl (thehndl: Handle;
                                    delim: char;
                                    var offset: longint {offset to copy from}
                                    ): Str255;
{Appends the given string to the handle (if handle is nil, allocates a new handle)}
    function MCAppendStrToHndl (str: Str255;
                                    var h: Handle): OSErr;
{Appends the contents of the pointer to the handle}
    function MCAppendPtrToHndl (p: Ptr;
                                    len: longint;
                                    var h: Handle): OSErr;
{Appends a return character to the handle}
    function MCAppendReturnToHndl (var h: Handle): OSErr;
{Appends the fromh handle onto the toh handle}
    function MCAppendHndlToHndl (fromh: handle;
                                    var toh: handle): OSErr;
{Converts a pascal string to a null-terminated string without using HyperXCMD.lib}
    function MCHPascalToZero (str: Str255): Handle;
{Converts a null-terminated string to a pascal string without using HyperXCMD.lib}
    function MCHZeroToPascal (strhdl: Handle): str255;
{Counts the number of lines in a null-terminated string}
    function MCNumberOfLinesInZero (thestr: handle): integer;
{Returns line X from null-terminated string as a pascal string}
    function MCGetStrLineXFromZero (lineno: integer;
                                    thehndl: handle): str255;

implementation

    procedure MCSetStrLen (var str: Str255;
                                    len: longint);
    begin
        if len > 255 then
            len := 255
        else if len < 0 then
            len := 0;
        str[0] := chr(len);
    end;

    procedure MCHndlToStr (thehndl: Handle;
                                    var str: Str255);
        var
            hndllen: longint;
    begin
        if thehndl = nil then
            begin
                DebugStr('nil handle in MCHndlToStr');
                str := '';
            end
        else
            begin
                str := '';
                hndllen := GetHandleSize(thehndl);
                if hndllen > 255 then
                    hndllen := 255;
                BlockMove(thehndl^, @str[1], hndllen);
                MCSetStrLen(str, hndllen);
            end;
    end;

    function MCCountLinesInHndl (thehndl: Handle): longint;
        var
            count: longint;
            returnstr: Str32;
            offset, lastoffset: longint;
    begin
        count := 0;
        if thehndl <> nil then
            begin
                returnstr := chr($0D); {store return in str}
                offset := 0;
                offset := Munger(thehndl, offset, @returnstr[1], 1, nil, 0); {get the first return}
                lastoffset := offset;
                while offset > 0 do {because if the first one is a return, it's not really a line}
                    begin
                        count := count + 1;
                        offset := offset + 1;{to avoid finding the same return}
                        offset := Munger(thehndl, offset, @returnstr[1], 1, nil, 0); {get the next return}
                        if offset > 0 then
                            lastoffset := offset; {and remember it if we found one}
                    end;
                if lastoffset <> GetHandleSize(thehndl) then
                    begin {if the last char is not a return, then there must be one more line}
                        count := count + 1;
                    end;
            end;
        MCCountLinesInHndl := count;
    end;

    function MCOldCountLinesInHndl (thehndl: Handle): longint;
{returns the number of return delimited lines in the handle pointed to by thehndl}
        var
            b: boolean;
            n: longint;
            p: ptr;
            count: longint;
            handsize: longint;
    begin
{intialize}
        if thehndl = nil then
            MCOldCountLinesInHndl := 0
        else
            begin
                handsize := GetHandleSize(thehndl) - 1;{remember to take out EOF if from a file!}
                if handsize > -1 then
                    begin
                        p := nil;
                        n := 0;
                        count := 0;
                        while n < handsize do
                            begin
                                p := pointer(ord4(thehndl^) + n);
                                n := n + 1;
                                if (p^ = $0D) then
                             {$0D is return}
                                    count := count + 1;
                            end;
                        if (p^ <> $0D) then
                            MCOldCountLinesInHndl := count + 1 {for the last line, wot doesn't end with a return}
                        else
                            MCOldCountLinesInHndl := count;
                    end
                else
                    MCOldCountLinesInHndl := 0;{because no returns either!}
            end;
    end;

    function MCGetHndlLineXFromHndl;
{this function returns a handle containing the specified line in thehndl}
        var
            b: boolean;
            n, count: longint;
            p, q: ptr;
            finalhandle: Handle;
            c: char;
            err: OSErr;
            l: integer;
            handsize: longint;
    begin
{move pointer to start of line x of string}
        handsize := GetHandleSize(thehndl) - 2;{- 2 because positions go from 0-49 if hs = 50, and pos 49 = EOF!!!}
        finalhandle := NewHandle(0);
        b := true;
        p := nil;
        n := 0;
        count := 0;
        while b and (n <= handsize - 2) do
            begin
                p := pointer(ord4(thehndl^) + n);
                n := n + 1;
                if count = linex - 1 then
                    b := false;
                if (p^ = $0D) then
                    count := count + 1;
                if p^ = 0 then
                    b := false;
            end;

{copy until hit another return or a zero into a string}
        if (p^ <> 0) and (n <= handsize) then
            begin
                b := true;
                l := 0;
                while b do
                    begin
                        if (p^ = $0D) or (p^ = 0) then
                            b := false
                        else
                            begin
                                c := chr(p^);
                                l := l + 1;
                                err := ptrAndHand(p, finalhandle, 1);
                            end;
                        p := pointer(ord4(thehndl^) + n);
                        n := n + 1;
                    end;
                MCGetHndlLineXFromHndl := finalHandle;
            end;
    end;

    function MCGetNextHndlLineFromHndl;
{starts looking from an offset passed to the function, which then contains where the}
{search left off last time}
{to search sequentially along a handle from start, pass 0 as the initial value for offset, and }
{keep calling with same value in a loop}
{should really rewrite some of these functions using BlockMove. Have to find out how to do it!}
        var
            b: boolean;
            count: longint;
            p, q: ptr;
            finalhandle: Handle;
            c: char;
            err: OSErr;
            l: integer;
            handsize: longint;
    begin
{move pointer to start of line x of string}
        handsize := GetHandleSize(thehndl) - 1;{remember to crop off the EOF if reading from a file}
        finalhandle := NewHandle(0);
        b := true;
        p := nil;

        p := pointer(ord4(thehndl^) + offset);
        offset := offset + 1;

{copy until hit another return or a zero into a string}
        if (p^ <> 0) and (offset <= handsize) then
            begin
                b := true;
                l := 0;
                while b do
                    begin
                        if (p^ = $0D) or (p^ = 0) then
                            b := false
                        else
                            begin
                                c := chr(p^);
                                err := ptrAndHand(p, finalhandle, 1);
                            end;
                        p := pointer(ord4(thehndl^) + offset);
                        offset := offset + 1;
                    end;
                offset := offset - 1;
                MCGetNextHndlLineFromHndl := finalHandle;
            end
        else if offset = handsize then
            MCGetNextHndlLineFromHndl := nil;
    end;

    function MCGetNextHndlItemFromHndl (thehndl: handle;
                                    delim: char;
                                    var offset: longint): Handle;
{starts looking from an offset passed to the function, which then contains where the}
{search left off last time}
{to search sequentially along a handle from start, pass 0 as the initial value for offset, and }
{keep calling with same value in a loop}
{should really rewrite some of these functions using BlockMove. Have to find out how to do it!}
        var
            b: boolean;
            count: longint;
            p, q: ptr;
            finalhandle: Handle;
            c: char;
            err: OSErr;
            l: integer;
            handsize: longint;
    begin
{move pointer to start of line x of string}
        handsize := GetHandleSize(thehndl) - 1;    {remember to crop off the EOF if reading from a file}
        finalhandle := NewHandle(0);
        b := true;
        p := nil;

        p := pointer(ord4(thehndl^) + offset);
        offset := offset + 1;

{copy until hit another return or a zero into a string}
        if (p^ <> 0) and (offset <= handsize) then
            begin
                b := true;
                l := 0;
                while b do
                    begin
                        if (p^ = ord(delim)) or (p^ = 0) then
                            b := false
                        else
                            begin
                                c := chr(p^);
                                err := ptrAndHand(p, finalhandle, 1);
                            end;
                        p := pointer(ord4(thehndl^) + offset);
                        offset := offset + 1;
                    end;
                offset := offset - 1;
                MCGetNextHndlItemFromHndl := finalHandle;
            end
        else if offset = handsize then
            MCGetNextHndlItemFromHndl := nil;
    end;

    function MCGetStrLineXFromHndl;
{finds the requested line number, and returns the contents of that line, with no return attached}
{NOTE - no longer trims the EOF character, cause it isn't always there, bimbo!}
        var
            b: boolean;
            n, count, offset: longint;
            p: ptr;
            thestr: str255;
            c: char;
            err: OSErr;
            l: longint;
            handsize: longint;
            retstr: str255;
    begin
{find offset of line number requested}
        count := 0;
        retstr := chr(13);
        offset := -1;
        while count < linex - 1 do
            begin
                offset := offset + 1;
                offset := Munger(thehndl, offset, @retstr[1], 1, nil, 0); {find next return}
                if offset < 0 then {return not found, line number does not exist}
                    begin
                        MCGetStrLineXFromHndl := '';
                        exit(MCGetStrLineXFromHndl);
                    end
                else
                    count := count + 1;
            end;

        n := offset + 1;
        p := Pointer(ord4(thehndl^) + n); {point p at the next character after the found return}

{copy what p points to until we hit the next return, or we go over the end of the handle}
        handsize := GetHandleSize(thehndl) - 1; {because the offsets start at 0}
        thestr := ''; {in case no more chars after this return}

        if (p^ <> 0) and (n <= handsize) then
            begin
                b := true;
                l := 0;
                while b do
                    begin
                        if (p^ = $0D) or (n > handsize) then
                            b := false
                        else
                            begin
                                c := chr(p^);
                                l := l + 1;
                                thestr[l] := c;
                            end;
                        n := n + 1;
                        p := pointer(ord4(thehndl^) + n);
                    end;
{turn it into a str255}
                MCSetStrLen(thestr, l);
            end;
{and return whatever thestr is}
        MCGetStrLineXFromHndl := thestr;
    end;

    function MCGetNumberOfItemsInStr;
{could rewrite using Munger or similar to search for returns..etc}
        var
            i: integer;
            count: integer;
    begin
        i := 0;
        count := 0;
        while i <= length(thestr) do
            begin
                i := i + 1;
                if thestr[i] = delimiter then
                    count := count + 1;
            end;
{if last character is not a delim, then there was one more item after last delimiter}
        if thestr[i] <> delimiter then
            MCGetNumberOfItemsInStr := count + 1; {for the last item}
    end;

    function MCGetStrItemXFromStr;
        var
            i, count: integer;
            newstr: Str255;
    begin
        newstr := thestr;
        count := 0;
        while count < itemx - 1 do
            begin
                i := pos(delimiter, newstr);
                if i <> 0 then
                    delete(newstr, 0, i + 1)
                else {can't find enough items}
                    newstr := '';
                count := count + 1;
            end;
        i := pos(delimiter, newstr);
        if i <> 0 then
            delete(newstr, i, length(newstr) - i + 1);
        MCGetStrItemXFromStr := newstr;
    end;



{-------------------------------------------------------------------}

    function MCGetStrItemXFromHndl (thehndl: Handle;
                                    itemx: longint;
                                    delimiter: char): str255;
        var
            count: longint;
            p: ptr;
            dels, newstr: Str255;
            offset, charstocopy, hlen: longint;
            n: longint;
    begin
{find offset of item}
        if thehndl = nil then
            begin
                MCGetStrItemXFromHndl := '';
                exit(MCGetStrItemXFromHndl);
            end;
        HLock(theHndl);
        count := 0;
        dels := delimiter;
        offset := -1;
        hlen := GetHandleSize(thehndl);
        while count < itemx - 1 do
            begin
                offset := offset + 1;
                offset := Munger(thehndl, offset, @dels[1], 1, nil, 0); {find next delimchar}
                if offset <= 0 then {delimchar 1 not found, line number does not exist}
                    begin
                        if hlen > 255 then
                            hlen := 255;
                        BlockMove(thehndl^, @newstr[1], hlen);
                        MCSetStrLen(newstr, hlen);
                        MCGetStrItemXFromHndl := newstr;
                        HUnlock(theHndl);
                        exit(MCGetStrItemXFromHndl);
                    end
                else
                    count := count + 1;
            end;

        n := offset + 1;
        p := Pointer(ord4(thehndl^) + n); {point p at the next character after the found return}
        offset := Munger(thehndl, offset + 1, @dels[1], 1, nil, 0); {find next delimchar}
        if offset <= 0 then
            offset := hlen;

{copy the item}
        charstocopy := offset - n;
        if charstocopy > 255 then
            charstocopy := 255;
        BlockMove(p, @newstr[1], charstocopy); {copy the diff into the string}
        if MemError <> noErr then
            MCGetStrItemXFromHndl := ''
        else
            begin
                MCSetStrLen(newstr, charstocopy);
                MCGetStrItemXFromHndl := newstr;
            end;
        Hunlock(thehndl);
    end;

{copies everything following the offset to the next occurrence of the delimiter}
{use this function}
    function MCGetStrItemOffsetFromHndl (thehndl: Handle;
                                    delim: char;
                                    var offset: longint {offset to copy from}
                                    ): Str255;
        var
            dels: Str32;
            endoff, len: longint;
            tmpstr: Str255;
    begin
        dels := delim;
        endoff := Munger(thehndl, offset, @dels[1], 1, nil, 0);
        if endoff <= 0 then
            begin
                endoff := GetHandleSize(thehndl);
                if offset >= endoff then
                    begin
                        MCGetStrItemOffsetFromHndl := '';
                        exit(MCGetStrItemOffsetFromHndl);
                    end;
            end;
        len := endoff - offset;
        if len > 255 then
            len := 255;
        BlockMove(ptr(ord4(thehndl^) + offset), @tmpstr[1], len);
        MCSetStrLen(tmpstr, len);
        MCGetStrItemOffsetFromHndl := tmpstr;
        offset := offset + len;
    end;

    function MCGetNextStrLineFromHndl (thehndl: handle;
                                    var offset: longint): Str255;
{starts looking from an offset passed to the function, which then contains where the search left off last time}
{to search sequentially along a handle from start, pass 0 as the initial value for offset, and }
{keep calling with same value in a loop}
{should really rewrite some of these functions using BlockMove. Have to find out how to do it!}
        var
            b: boolean;
            count: longint;
            p, q: ptr;
            finalhandle: Handle;
            c: char;
            err: OSErr;
            l: integer;
            handsize: longint;
            tmpstr: str255;
    begin
{move pointer to start of line x of handle}
        handsize := GetHandleSize(thehndl) - 1;{remember to crop off the EOF if reading from a file}
        finalhandle := NewHandle(0);
        b := true;
        p := nil;

        p := pointer(ord4(thehndl^) + offset);{p should now be pointing where we left off}
        offset := offset + 1;{first char of line}

{copy until hit another return or a zero into a string}
        if (p^ <> 0) and (offset <= handsize) then
            begin
                b := true;
                l := 0;
                count := 1;
                while b and (count < 255) do
                    begin
                        if (p^ = $0D) or (p^ = 0) then
                            b := false
                        else
                            begin
                                c := chr(p^);
                                tmpstr[count] := c;
                                count := count + 1;
                            end;
                        p := pointer(ord4(thehndl^) + offset);
                        offset := offset + 1;
                    end;
                offset := offset - 1;
                MCSetStrLen(tmpstr, count - 1);
                MCGetNextStrLineFromHndl := tmpstr;
            end
        else if offset = handsize then
            MCGetNextStrLineFromHndl := '';
    end;

    function MCAppendStrToHndl;
    begin
        MCAppendStrToHndl := noErr;
        if str = '' then
            exit(MCAppendStrToHndl);
        if h = nil then
            h := NewHandle(0);
        MCAppendStrToHndl := PtrAndHand(POINTER(ORD4(@str) + 1), h, LENGTH(str));
    end;

    function MCAppendPtrToHndl;
    begin
        MCAppendPtrToHndl := noErr;
        if p = nil then
            exit(MCAppendPtrToHndl);
        if h = nil then
            h := NewHandle(0);
        MCAppendPtrToHndl := PtrAndHand(p, h, len);
    end;

    function MCAppendReturnToHndl;
        var
            s: str255;
    begin
        MCAppendReturnToHndl := noErr;
        if h = nil then
            h := NewHandle(0);
        s := chr($0D);
        MCAppendReturnToHndl := PtrAndHand(POINTER(ORD4(@s) + 1), h, LENGTH(s));
    end;

    function MCAppendHndlToHndl;
{appends handle fromh after handle toh}
        var
            len: longint;
            myerr: OSErr;
    begin
        MCAppendHndlToHndl := noErr;
        if toh = nil then
            toh := NewHandle(0);
        if fromh = nil then
            exit(MCAppendHndlToHndl);
        MCAppendHndlToHndl := HandAndHand(fromh, toh);
    end;

    function MCHPascalToZero;
{converts a pascal string to hypercard (null-terminated) string without using paramptr}
        var
            myErr: OSErr;
            strHdl: Handle;
    begin
        strHdl := nil;
        myErr := MCAppendStrToHndl(concat(str, chr(0)), strHdl);
        if (myErr = noErr) and (strHdl <> nil) then
            MCHPascalToZero := strHdl
        else
            MCHPascalToZero := nil;
    end;

    function MCHZeroToPascal;
{converts a hypercard(null-terminated) string to pascal string without using paramptr}
{copes if it doesn't actually have a zero on the end}
        var
            n: integer;
            size: integer;
            s1: Str255;
            offset: longint;
    begin
        size := 0;
        offset := -1;
        s1 := chr(0);
        if (strhdl = nil) then {old stuff fucked up if used a fake handle}
            begin
                MCHZeroToPascal := '';
                exit(MCHZeroToPascal);
            end;
{ find the nil}
        offset := Munger(strhdl, 0, pointer(ord4(@s1[1])), 1, nil, 0);
        if (offset < 0) then {not a hypercard handle, but we can cope nonetheless}
            offset := GetHandleSize(strhdl);
        if offset > 255 then
            size := 255
        else
            size := offset;
        if (size = 0) then
            begin
                MCHZeroToPascal := '';
                exit(MCHZeroToPascal);
            end;
        MCSetStrLen(s1, size);
        BlockMove(strhdl^, Pointer(ord4(@s1[1])), size);
        MCHZeroToPascal := s1;
    end;

    function MCNumberOfLinesInZero;
        var
            b: boolean;
            n: integer;
            p: ptr;
            count: integer;
    begin
{intialize}
        b := true;
        p := nil;
        n := 0;
        count := 0;
        while b do
            begin
                p := pointer(ord4(thestr^) + n);
                n := n + 1;
                if (p^ = $0D) then
 {$0D is return}
                    count := count + 1;
                if p^ = 0 then
                    b := false;
            end;
        MCNumberOfLinesInZero := count;
    end;

    function MCGetStrLineXFromZero;
        var
            b: boolean;
            n, count: integer;
            p, q: ptr;
            thestr: str255;
            c: char;
            err: OSErr;
            l: integer;
    begin
{move pointer to start of line x of string}
        b := true;
        p := nil;
        n := 0;
        count := 0;
        while b do
            begin
                p := pointer(ord4(thehndl^) + n);
                n := n + 1;
                if count = lineno - 1 then
                    b := false;
                if (p^ = $0D) then
                    count := count + 1;
                if p^ = 0 then
                    b := false;
            end;

{copy until hit another return or a zero into a string}
        if p^ <> 0 then
            begin
                b := true;
                l := 0;
                while b do
                    begin
                        if (p^ = $0D) or (p^ = 0) then
                            b := false
                        else
                            begin
                                c := chr(p^);
                                l := l + 1;
                                thestr[l] := c;
                            end;
                        p := pointer(ord4(thehndl^) + n);
                        n := n + 1;
                    end;
{turn it into a str255}
                MCSetStrLen(thestr, l);
                MCGetStrLineXFromZero := thestr;
            end;
    end;

end.